home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / CRYSTAL / VOUTPUT.MOD < prev    next >
Encoding:
Modula Implementation  |  1994-01-04  |  11.7 KB  |  544 lines
  1. IMPLEMENTATION MODULE VOutput;
  2.  
  3. (*
  4. VDI Output Functions.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM VDI    IMPORT contrl,intin,intout,ptsin,ptsout,v,CallVDI,vdi,EOS,
  12.                    Integer,IntegerInputRange,PointsInputRange,
  13.                    MaxInput,MaxPoints;
  14. FROM PORTAB IMPORT ANYWORD,ANYTYPE,ANYBYTE,UNSIGNEDWORD,WORDSET;
  15. FROM SYSTEM IMPORT ADR;
  16. CAST_IMPORT
  17.  
  18. PROCEDURE VPLine(    Handle: UNSIGNEDWORD;
  19.                      Count : UNSIGNEDWORD;
  20.                  VAR PXY   : ARRAY OF XY);
  21. #if long
  22. VAR i: [0..(MaxPoints - 1)];
  23. #endif
  24.  
  25. BEGIN
  26. #if long
  27.   FOR i:= 0 TO (2 * Count - 1) DO
  28.     ptsin[i]:= PXY[i];
  29.   END;
  30. #else
  31.   v.pioff:= ADR(PXY);
  32. #endif
  33.   CallVDI(6,Count,0,Handle);
  34. #if not long
  35.   v.pioff:= ADR(ptsin);
  36. #endif
  37. END VPLine;
  38.  
  39. PROCEDURE VPMarker(    Handle: UNSIGNEDWORD;
  40.                        Count : UNSIGNEDWORD;
  41.                    VAR PXY   : ARRAY OF XY);
  42. #if long
  43. VAR i: [0..(MaxPoints - 1)];
  44. #endif
  45. BEGIN
  46. #if long
  47.   FOR i:= 0 TO (2 * Count - 1) DO
  48.     ptsin[i]:= PXY[i];
  49.   END;
  50. #else
  51.   v.pioff:= ADR(PXY);
  52. #endif
  53.   CallVDI(7,Count,0,Handle);
  54. #if not long
  55.   v.pioff:= ADR(ptsin);
  56. #endif
  57. END VPMarker;
  58.  
  59. PROCEDURE VGText(    Handle: UNSIGNEDWORD;
  60.                      X     : XY;
  61.                      Y     : XY;
  62.                  VAR Text  : ARRAY OF CHAR);
  63.  
  64. VAR i: [0..MaxInput];
  65.  
  66. BEGIN
  67.   ptsin[0]:= X;
  68.   ptsin[1]:= Y;
  69.   i:= 0;
  70.   WHILE Text[i] # EOS DO
  71.     intin[i]:= ORD(Text[i]);
  72.     INC(i);
  73.   END;
  74.   WITH contrl DO
  75.     c[0]:= 8;
  76.     c[1]:= 1;
  77.     c[3]:= i; (* (i - 1) + 1 = i *)
  78.     c[6]:= Handle;
  79.   END;
  80.   vdi;
  81. END VGText;
  82.  
  83. PROCEDURE VEText(  Handle : UNSIGNEDWORD;
  84.                      X      : XY;
  85.                      Y      : XY;
  86.                  VAR Text   : ARRAY OF CHAR;
  87.                  VAR Offsets: ARRAY OF XY);
  88.  
  89. VAR i: [0..MaxInput - 1];
  90.  
  91. BEGIN
  92.   ptsin[0]:= X;
  93.   ptsin[1]:= Y;
  94.   i:= 0;
  95.   WHILE Text[i] # EOS DO
  96.     intin[i]:= ORD(Text[i]);
  97.     ptsin[2 * i + 2]:= Offsets[2 * i];
  98.     ptsin[2 * i + 3]:= Offsets[2 * i + 1];
  99.     INC(i);
  100.   END;
  101.   contrl.c[5]:= 11;
  102.   CallVDI(11,i + 1,i,Handle); (* (i + 1) - 1 + 1 = i + 1 *)
  103. END VEText;
  104.  
  105. PROCEDURE VFillArea(    Handle: UNSIGNEDWORD;
  106.                         Count : UNSIGNEDWORD;
  107.                     VAR PXY   : ARRAY OF XY);
  108. #if long
  109. VAR i: [0..(MaxPoints - 1)];
  110. #endif
  111. BEGIN
  112. #if long
  113.   FOR i:= 0 TO (2 * Count - 1) DO
  114.     ptsin[i]:= PXY[i];
  115.   END;
  116. #else
  117.   v.pioff:= ADR(PXY);
  118. #endif
  119.   CallVDI(9,Count,0,Handle);
  120. #if not long
  121.   v.pioff:= ADR(ptsin);
  122. #endif
  123. END VFillArea;
  124.  
  125. PROCEDURE VCellArray(  Handle   : UNSIGNEDWORD;
  126.                      VAR PXY      : ARRAY OF XY;
  127.                          RowLength: UNSIGNEDWORD;
  128.                          ElUsed   : UNSIGNEDWORD;
  129.                          NumRows  : UNSIGNEDWORD;
  130.                          WrtMode  : WritingModes;
  131.                      VAR ColArray : ARRAY OF ANYWORD);
  132. #if long
  133. CONST Max = 512;
  134.  
  135. VAR i: [0..(Max - 1)];
  136. #endif
  137. BEGIN
  138. #if long
  139.   FOR i:= 0 TO (RowLength * NumRows) DO
  140.     intin[i]:= ColArray[i];
  141.   END;
  142.   FOR i:= 0 TO 3 DO
  143.     ptsin[i]:= PXY[i];
  144.   END;
  145. #else
  146.   v.iioff:= ADR(ColArray);
  147.   v.pioff:= ADR(PXY);
  148. #endif
  149.   WITH contrl DO
  150.     c[7]:= RowLength;
  151.     c[8]:= ElUsed;
  152.     c[9]:= NumRows;
  153.     c[10]:= ORD(WrtMode);
  154.   END;
  155.   CallVDI(10,2,RowLength * NumRows,Handle);
  156. #if not long
  157.   v.iioff:= ADR(intin);
  158.   v.pioff:= ADR(ptsin);
  159. #endif
  160. END VCellArray;
  161.  
  162. PROCEDURE VContourFill(Handle: UNSIGNEDWORD;
  163.                        X     : XY;
  164.                        Y     : XY;
  165.                        Index : UNSIGNEDWORD);
  166. BEGIN
  167.   intin[0]:= Index;
  168.   ptsin[0]:= X;
  169.   ptsin[1]:= Y;
  170.   CallVDI(103,1,1,Handle);
  171. END VContourFill;
  172.  
  173. PROCEDURE VRRecFl(    Handle: UNSIGNEDWORD;
  174.                   VAR PXY   : ARRAY OF XY);
  175. #if long
  176. VAR i: [0..3];
  177. #endif
  178. BEGIN
  179. #if long
  180.   FOR i:= 0 TO 3 DO
  181.     ptsin[i]:= PXY[i];
  182.   END;
  183. #else
  184.   v.pioff:= ADR(PXY);
  185. #endif
  186.   CallVDI(114,2,0,Handle);
  187. #if not long
  188.   v.pioff:= ADR(ptsin);
  189. #endif
  190. END VRRecFl;
  191.  
  192. PROCEDURE VBar(    Handle: UNSIGNEDWORD;
  193.                VAR PXY   : ARRAY OF XY);
  194. #if long
  195. VAR i: [0..3];
  196. #endif
  197. BEGIN
  198. #if long
  199.   FOR i:= 0 TO 3 DO
  200.     ptsin[i]:= PXY[i];
  201.   END;
  202. #else
  203.   v.pioff:= ADR(PXY);
  204. #endif
  205.   contrl.c[5]:= 1;
  206.   CallVDI(11,2,0,Handle);
  207. #if not long
  208.   v.pioff:= ADR(ptsin);
  209. #endif
  210. END VBar;
  211.  
  212. PROCEDURE VArc(Handle: UNSIGNEDWORD;
  213.                X     : XY;
  214.                Y     : XY;
  215.                Radius: UNSIGNEDWORD;
  216.                BegAng: UNSIGNEDWORD;
  217.                EndAng: UNSIGNEDWORD);
  218. BEGIN
  219.   ptsin[0]:= X;
  220.   ptsin[1]:= Y;
  221.   ptsin[2]:= 0;
  222.   ptsin[3]:= 0;
  223.   ptsin[4]:= 0;
  224.   ptsin[5]:= 0;
  225.   ptsin[6]:= Radius;
  226.   ptsin[7]:= 0;
  227.   intin[0]:= BegAng;
  228.   intin[1]:= EndAng;
  229.   contrl.c[5]:= 2;
  230.   CallVDI(11,4,2,Handle);
  231. END VArc;
  232.  
  233. PROCEDURE VPie(Handle: UNSIGNEDWORD;
  234.                X     : XY;
  235.                Y     : XY;
  236.                Radius: UNSIGNEDWORD;
  237.                BegAng: UNSIGNEDWORD;
  238.                EndAng: UNSIGNEDWORD);
  239. BEGIN
  240.   ptsin[0]:= X;
  241.   ptsin[1]:= Y;
  242.   ptsin[2]:= 0;
  243.   ptsin[3]:= 0;
  244.   ptsin[4]:= 0;
  245.   ptsin[5]:= 0;
  246.   ptsin[6]:= Radius;
  247.   ptsin[7]:= 0;
  248.   intin[0]:= BegAng;
  249.   intin[1]:= EndAng;
  250.   contrl.c[5]:= 3;
  251.   CallVDI(11,4,2,Handle);
  252. END VPie;
  253.  
  254. PROCEDURE VCircle(Handle: UNSIGNEDWORD;
  255.                   X     : XY;
  256.                   Y     : XY;
  257.                   Radius: UNSIGNEDWORD);
  258. BEGIN
  259.   ptsin[0]:= X;
  260.   ptsin[1]:= Y;
  261.   ptsin[2]:= 0;
  262.   ptsin[3]:= 0;
  263.   ptsin[4]:= Radius;
  264.   ptsin[5]:= 0;
  265.   contrl.c[5]:= 4;
  266.   CallVDI(11,3,0,Handle);
  267. END VCircle;
  268.  
  269. PROCEDURE VEllipse(Handle : UNSIGNEDWORD;
  270.                    X      : XY;
  271.                    Y      : XY;
  272.                    XRadius: UNSIGNEDWORD;
  273.                    YRadius: UNSIGNEDWORD);
  274. BEGIN
  275.   ptsin[0]:= X;
  276.   ptsin[1]:= Y;
  277.   ptsin[2]:= XRadius;
  278.   ptsin[3]:= YRadius;
  279.   contrl.c[5]:= 5;
  280.   CallVDI(11,2,0,Handle);
  281. END VEllipse;
  282.  
  283. PROCEDURE VEllArc(Handle : UNSIGNEDWORD;
  284.                   X    : XY;
  285.                   Y    : XY;
  286.                   XRadius: UNSIGNEDWORD;
  287.                   YRadius: UNSIGNEDWORD;
  288.                   BegAng : UNSIGNEDWORD;
  289.                   EndAng : UNSIGNEDWORD);
  290. BEGIN
  291.   ptsin[0]:= X;
  292.   ptsin[1]:= Y;
  293.   ptsin[2]:= XRadius;
  294.   ptsin[3]:= YRadius;
  295.   intin[0]:= BegAng;
  296.   intin[1]:= EndAng;
  297.   contrl.c[5]:= 6;
  298.   CallVDI(11,2,2,Handle);
  299. END VEllArc;
  300.  
  301. PROCEDURE VEllPie(Handle : UNSIGNEDWORD;
  302.                   X    : XY;
  303.                   Y    : XY;
  304.                   XRadius: UNSIGNEDWORD;
  305.                   YRadius: UNSIGNEDWORD;
  306.                   BegAng : UNSIGNEDWORD;
  307.                   EndAng : UNSIGNEDWORD);
  308. BEGIN
  309.   ptsin[0]:= X;
  310.   ptsin[1]:= Y;
  311.   ptsin[2]:= XRadius;
  312.   ptsin[3]:= YRadius;
  313.   intin[0]:= BegAng;
  314.   intin[1]:= EndAng;
  315.   contrl.c[5]:= 7;
  316.   CallVDI(11,2,2,Handle);
  317. END VEllPie;
  318.  
  319. PROCEDURE VRBox(    Handle: UNSIGNEDWORD;
  320.                 VAR PXY   : ARRAY OF XY);
  321. #if long
  322. VAR i: [0..3];
  323. #endif
  324. BEGIN
  325. #if long
  326.   FOR i:= 0 TO 3 DO
  327.     ptsin[i]:= PXY[i];
  328.   END;
  329. #else
  330.   v.pioff:= ADR(PXY);
  331. #endif
  332.   contrl.c[5]:= 8;
  333.   CallVDI(11,2,0,Handle);
  334. #if not long
  335.   v.pioff:= ADR(ptsin);
  336. #endif
  337. END VRBox;
  338.  
  339. PROCEDURE VRFBox(  Handle: UNSIGNEDWORD;
  340.                  VAR PXY   : ARRAY OF XY);
  341. #if long
  342. VAR i: [0..3];
  343. #endif
  344. BEGIN
  345. #if long
  346.   FOR i:= 0 TO 3 DO
  347.     ptsin[i]:= PXY[i];
  348.   END;
  349. #else
  350.   v.pioff:= ADR(PXY);
  351. #endif
  352.   contrl.c[5]:= 9;
  353.   CallVDI(11,2,0,Handle);
  354. #if not long
  355.   v.pioff:= ADR(ptsin);
  356. #endif
  357. END VRFBox;
  358.  
  359. PROCEDURE VJustified(  Handle    : UNSIGNEDWORD;
  360.                          X         : XY;
  361.                          Y         : XY;
  362.                      VAR Text    : ARRAY OF CHAR;
  363.                          TextLength: UNSIGNEDWORD;
  364.                          WordSpace : BOOLEAN;
  365.                          CharSpace : BOOLEAN;
  366.                          CharInfo  : BOOLEAN;
  367.                      VAR CharWidth : ARRAY OF UNSIGNEDWORD);
  368.  
  369. VAR i: [0..(MaxInput - 1)];
  370.  
  371. BEGIN
  372.   ptsin[0]:= X;
  373.   ptsin[1]:= Y;
  374.   ptsin[2]:= TextLength;
  375.   ptsin[3]:= 0;
  376. #if (defined SPCM2) || (defined LPRM2)
  377.   intin[0]:= ORD(WordSpace);
  378.   IF CharInfo THEN
  379.     INCL(CAST(WORDSET,intin[0]),15);
  380.   END;
  381.   intin[1]:= ORD(CharSpace);
  382. #else
  383.   intin[0]:= 8000H * ORD(CharInfo) + ORD(WordSpace);
  384.   intin[1]:= ORD(CharSpace);
  385. #endif
  386.   i:= 0;
  387.   WHILE Text[i] # EOS DO
  388.     intin[i + 2]:= ORD(Text[i]);
  389.     INC(i);
  390.   END;
  391. #if not long
  392.   v.iooff:= ADR(CharWidth);
  393. #endif
  394.   contrl.c[5]:= 10;
  395.   CallVDI(11,2,i + 1,Handle);  (* (i - 1) + 2 = i + 1 *)
  396. #if not long
  397.   v.iooff:= ADR(intout);
  398. #else
  399.   WHILE i > 0 DO
  400.     DEC(i);
  401.     CharWidth[i]:= intout[i];
  402.   END;
  403. #endif
  404. END VJustified;
  405.  
  406. PROCEDURE VBez(    Handle  : UNSIGNEDWORD;
  407.                    Count   : UNSIGNEDWORD;
  408.                VAR PXY     : ARRAY OF XY;
  409.                VAR BezArray: ARRAY OF ANYBYTE;
  410.                VAR Extent  : ARRAY OF XY;
  411.                VAR NPoints : UNSIGNEDWORD;
  412.                VAR NMove   : UNSIGNEDWORD);
  413.  
  414. VAR i        : [0..(MaxInput + 1)];
  415.     ByteArray: ARRAY IntegerInputRange OF ANYBYTE;
  416.  
  417. BEGIN
  418.   v.pioff:= ADR(PXY);
  419.   v.iioff:= ADR(ByteArray);
  420.  
  421.   (* ByteArray        : [0] [1] [2] [3] [4] [5] *)
  422.   (* := BezArray[0..4]: [1] [0] [3] [2] [?] [4] *)
  423.  
  424.   i:= 0;
  425.  
  426.   WHILE i < Count DO
  427.     ByteArray[i + 1]:= BezArray[i];
  428.     IF (i + 1) < Count THEN
  429.       ByteArray[i]:= BezArray[i + 1];
  430.     END;
  431.     INC(i,2);
  432.   END;
  433.  
  434.   v.pooff:= ADR(Extent);
  435.   contrl.c[2]:= 2; (* ATARI docs say so *)
  436.   contrl.c[4]:= 6; (* ATARI docs say so *)
  437.   contrl.c[5]:= 13;
  438.   CallVDI(6,Count,(Count + 1) DIV 2,Handle);
  439.   v.pioff:= ADR(ptsin);
  440.   v.iioff:= ADR(intin);
  441.   v.pooff:= ADR(ptsout);
  442.   NPoints:= intout[0];
  443.   NMove:= intout[1];
  444. END VBez;
  445.  
  446. PROCEDURE VBezFill(    Handle  : UNSIGNEDWORD;
  447.                        Count   : UNSIGNEDWORD;
  448.                    VAR PXY     : ARRAY OF XY;
  449.                    VAR BezArray: ARRAY OF ANYBYTE;
  450.                    VAR Extent  : ARRAY OF XY;
  451.                    VAR NPoints : UNSIGNEDWORD;
  452.                    VAR NMove   : UNSIGNEDWORD);
  453.  
  454. VAR i        : [0..(MaxInput + 1)];
  455.     ByteArray: ARRAY IntegerInputRange OF ANYBYTE;
  456.  
  457. BEGIN
  458.   v.pioff:= ADR(PXY);
  459.   v.iioff:= ADR(ByteArray);
  460.  
  461.   (* ByteArray        : [0] [1] [2] [3] [4] [5] *)
  462.   (* := BezArray[0..4]: [1] [0] [3] [2] [?] [4] *)
  463.  
  464.   i:= 0;
  465.  
  466.   WHILE i < Count DO
  467.     ByteArray[i + 1]:= BezArray[i];
  468.     IF (i + 1) < Count THEN
  469.       ByteArray[i]:= BezArray[i + 1];
  470.     END;
  471.     INC(i,2);
  472.   END;
  473.  
  474.   v.pooff:= ADR(Extent);
  475.   contrl.c[2]:= 2;
  476.   contrl.c[4]:= 6;
  477.   contrl.c[5]:= 13;
  478.   CallVDI(9,Count,(Count + 1) DIV 2,Handle);
  479.   v.pioff:= ADR(ptsin);
  480.   v.iioff:= ADR(intin);
  481.   v.pooff:= ADR(ptsout);
  482.   NPoints:= intout[0];
  483.   NMove:= intout[1];
  484. END VBezFill;
  485.  
  486. PROCEDURE VFText(    Handle: UNSIGNEDWORD;
  487.                      X     : XY;
  488.                      Y     : XY;
  489.                  VAR Text  : ARRAY OF CHAR);
  490.  
  491. VAR i: [0..MaxInput];
  492.  
  493. BEGIN
  494.   ptsin[0]:= X;
  495.   ptsin[1]:= Y;
  496.   i:= 0;
  497.   WHILE Text[i] # EOS DO
  498.     intin[i]:= ORD(Text[i]);
  499.     INC(i);
  500.   END;
  501.   WITH contrl DO
  502.     c[0]:= 241;
  503.     c[1]:= 1;
  504.     c[3]:= i; (* (i - 1) + 1 = i *)
  505.     c[6]:= Handle;
  506.   END;
  507.   vdi;
  508. END VFText;
  509.  
  510. PROCEDURE VFTextOffset(    Handle: UNSIGNEDWORD;
  511.                            X     : XY;
  512.                            Y     : XY;
  513.                        VAR Text  : ARRAY OF CHAR;
  514.                        VAR Offset: ARRAY OF XY);
  515.  
  516. VAR i: [0..MaxInput];
  517.     j: PointsInputRange;
  518.  
  519. BEGIN
  520.   ptsin[0]:= X;
  521.   ptsin[1]:= Y;
  522.  
  523.   i:= 0;
  524.   WHILE Text[i] # EOS DO
  525.     intin[i]:= ORD(Text[i]);
  526.     INC(i);
  527.   END;
  528.  
  529.   FOR j:= 0 TO (2 * i - 1) DO
  530.     ptsin[j + 2]:= Offset[j];
  531.   END;
  532.  
  533.   WITH contrl DO
  534.     c[0]:= 241; (* yes, 241! *)
  535.     c[1]:= i + 1;
  536.     c[3]:= i; (* (i - 1) + 1 = i *)
  537.     c[6]:= Handle;
  538.   END;
  539.   vdi;
  540. END VFTextOffset;
  541.  
  542. END VOutput.
  543.  
  544.